home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1996 September / JCSM Shareware Collection (JCS Distribution) (September 1996).ISO / prgtools / wformpas.zip / test.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-04  |  5KB  |  157 lines
  1. {programm    : wbild.pas
  2.  Funktion    : Anzeige der bildwiederholungsfrequenz unter Windows
  3.  Autor       : Wilfried Lottermoser
  4. }
  5.  
  6. PROGRAM wbild;
  7. USES owindows,wintypes,winprocs,strings,windos;
  8. TYPE
  9.       TMyApplication                   = object(TApplication)
  10.                                            PROCEDURE InitMainWindow; virtual;
  11.                                            FUNCTION ProcessAppMsg(VAR message: tmsg): boolean;virtual;
  12.                                          END;
  13.  
  14.       Pfenster     = ^TFenster;
  15.       TFenster     = object (TWindow)
  16.                        WDC             : HDC;
  17.                        gett            : real;
  18.                        f               : ARRAY[0..9] OF real;
  19.                        Count           : byte;
  20.                        busy            : boolean;
  21.                        xres,yres       : STRING;
  22.                        CONSTRUCTOR Init (Mutterfenster: pwindowsobject;ztitel: pchar);
  23.                        PROCEDURE   sync;
  24.                        PROCEDURE   GetWindowClass(VAR awndclass: twndclass);virtual;
  25.                        PROCEDURE   getfreq(VAR msg: tmessage);virtual  wm_first+ wm_user;
  26.                        PROCEDURE   display(strg:STRING);
  27.                        FUNCTION    CanClose:boolean;virtual;
  28.                        DESTRUCTOR  Done;virtual;
  29.                      END; {tfenster}
  30.  
  31. VAR 
  32.       myapp        : TMyApplication;
  33.  
  34. {------------------------------------------------------------------------}
  35.  
  36. PROCEDURE TMyApplication.InitMainWindow;
  37. BEGIN
  38.   MainWindow := New(Pfenster, Init(NIL, 'wbild'));
  39. END;
  40.  
  41. FUNCTION TMyApplication.ProcessAppMsg(VAR 
  42.       message      : tmsg)             : boolean;
  43. BEGIN
  44.   IF (message.message = wm_timer)THEN BEGIN
  45.     SendMessage(MainWindow^.HWindow,wm_user,0,0);
  46.   END;
  47.   ProcessAppMsg:=TApplication.ProcessAppMsg(message);
  48. END;
  49.  
  50. {------------------------------------------------------------------------}
  51.  
  52. CONSTRUCTOR TFenster.Init(mutterfenster: pwindowsobject;ztitel: pchar);
  53. VAR 
  54.       t            : word;
  55. BEGIN
  56.   TWindow.Init(mutterfenster,ztitel);
  57.   { zeitgeber mit 2-sekundentakt setzen}
  58.   IF SetTimer(HWindow,1,3000,NIL)=0 THEN
  59.     MessageBox(HWindow,'fehler beim anlegen des zeitgebers','',mb_ok);
  60.   FOR t:=0 TO 9 DO f[t]:=0;Count:=0;
  61.   Attr.w:=170;Attr.h:=60;
  62.   Str(GetSystemMetrics(sm_cxscreen),xres);
  63.   Str(GetSystemMetrics(sm_cyscreen),yres);
  64. END;
  65.  
  66. PROCEDURE TFenster.GetWindowClass;
  67. BEGIN
  68.   INHERITED GetWindowClass(awndclass);
  69.   Awndclass.style:=awndclass.style OR cs_dblclks;
  70.   Awndclass.hicon:=0;                 { hiermit wird die Symbolanzeige aktiviert}
  71. END;
  72.  
  73. PROCEDURE TFenster.sync; { Synchronisation mit vertikalem Kathodenstrahlrueckgang }
  74. VAR 
  75.       m            : tmsg;
  76. BEGIN
  77.   REPEAT UNTIL (port[$3da] AND 8)=0;
  78.   REPEAT UNTIL (port[$3da] AND 8)=8;
  79.   {ankommende botschaften weiterleiten}
  80.   IF PeekMessage(m,0,0,0,pm_remove) THEN BEGIN
  81.     TranslateMessage(m); DispatchMessage(m);
  82.   END;
  83. END;
  84.  
  85. PROCEDURE TFenster.getfreq(VAR 
  86.       msg          : tmessage);
  87. CONST 
  88.       SyncCount    = 100;
  89. VAR 
  90.       strg         : STRING;
  91.       h,h2,m,m2,s,s2,s100,s200,i       : word;
  92.       freq         : real;
  93. BEGIN
  94.   busy:=true;
  95.   IF f[1]=0 THEN display('wait');
  96.   inc(Count);
  97.   Count:=Count MOD 10;
  98.   sync;
  99.   GetTime(h,m,s,s100);
  100.   FOR i:=1 TO SyncCount DO sync;
  101.   GetTime(h2,m2,s2,s200);
  102.   f[Count]:=SyncCount/(100*(h2*36+m2*0.6+s2/100+s200/10000-h*36-m*0.6-s/100-s100/10000));
  103.   freq:=0;
  104.   FOR i:=0 TO 9 DO freq:=freq+f[i];
  105.   freq:=freq/10;
  106.   Str(freq:3:2,strg);
  107.   IF NOT IsIconic(HWindow) THEN display(xres+'*'+yres+'  v='+strg+'hz') ELSE display(strg);
  108.   busy:=false;
  109. END;
  110.  
  111. PROCEDURE TFenster.display(strg:STRING);
  112. VAR 
  113.       AChar        : ARRAY[0..255] OF char;
  114.       rect         : trect;
  115. BEGIN
  116.   Strpcopy(AChar,strg);
  117.   Wdc:=GetDC(HWindow);
  118.   SetBkColor(wdc,rgb(0,170,0));                 {Hintergrundfarbe grⁿn}
  119.   SetTextAlign(wdc,ta_center OR ta_bottom);     {Text zentriert}
  120.   WITH rect DO BEGIN
  121.     left:=0; right:=Attr.w; top:=0;  bottom:=Attr.h;
  122.   END;
  123.   IF IsIconic(HWindow) THEN ExtTextOut(wdc,18,25,eto_opaque,@rect,AChar,strlen(AChar),NIL) ELSE
  124.     BEGIN
  125.       ExtTextOut(wdc,Attr.w DIV 2,Attr.h DIV 2,eto_opaque,@rect,AChar,strlen(AChar),NIL);
  126.     END;
  127.   ReleaseDC(HWindow,wdc);
  128. END;
  129.  
  130. FUNCTION TFenster.CanClose:boolean;
  131. VAR 
  132.       m            : tmsg;
  133. BEGIN
  134.   display('end');
  135.   CanClose:=NOT busy;
  136.   {wenn gerade eine Zeitmessung erfolgt die Botschaft wm_close aufschieben}
  137.   m.message:=wm_close;
  138.   IF busy THEN DispatchMessage(m);
  139. END;
  140.  
  141. DESTRUCTOR TFenster.Done;
  142. VAR 
  143.       m            : tmsg;
  144.       ms           : tmessage;
  145. BEGIN
  146.   KillTimer(HWindow,1);                 {Zeitgeber entfernen}
  147.   TWindow.Done;
  148. END;
  149.  
  150. {------------------------------------------------------------------------}
  151.  
  152. BEGIN
  153.   myapp.Init('');
  154.   myapp.Run;
  155.   myapp.Done;
  156. END.
  157.